home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 4
/
Precision Software Applications Silver Collection Volume 4 (1993).iso
/
new
/
cuaclip.arj
/
EX3.PRG
< prev
next >
Wrap
Text File
|
1993-06-01
|
5KB
|
209 lines
/*********************************************************************
EX3.PRG - CUA-Clip Library examples.
This file contains sample code illustrating both the GET
and Event systems working in combination.
Author: Dave Rooney
Date : Feb. 22, 1993
*********************************************************************/
#include "Demo.CH"
//
// Example 3 - Performing GET's while a real-time clock is displayed.
//
FUNCTION Combo_Examples
LOCAL cScreen, ; // Screen behind the dialog box
cOldColor, ; // Colour on entry
bInterrupt, ; // Interrupt code block on entry
GetList, ; // Local GetList array
cPrinter, ; // Name of the printer
nPort, ; // Printer port selected
lPostScript, ; // .T. if the printer is PostScript
aPrinters, ; // DBLIST array for the Printer lookup
aPorts // Radio button array for the Printer port
//
// Initialize the variables...
//
cOldColor := SETCOLOR()
GetList := {}
cPrinter := SPACE(30)
nPort := 1
lPostScript := .F.
//
// Set an interrupt function to be called during wait states,
// i.e. InterruptKey(). Note that we're saving the current
// interrupt code block which we'll restore later.
//
bInterrupt := SetInterrupt( {|| MyInterrupt() } )
//
// Ensure Printer.DBF/.NTX are there. If not, make 'em!
//
IF !( FILE( "Printer.DBF" ) .AND. FILE( "Printer.NTX" ))
_BuildPrinter()
ENDIF
//
// Radio button array for the printer port...
//
aPorts := { { { 1, "LPT1" }, { 2, "LPT2" }, { 3, "LPT3" } } }
//
// List of available printers:
//
// Table Index Display Exp. Search Exp.
// v v v v
//
aPrinters := { "Printer", "Printer",, {|| FIELD->PrnName },, {|x| UPPER(x) } }
//
// Open the printer file.
//
IF DBNetUse( .T., "DBFNTX", "Printer" )
DBSETINDEX( "Printer" )
ELSE
SETCOLOR( cOldColor )
RETURN NIL
ENDIF
//
// Display the dialog box
//
cScreen := ShadowBox( 2, 12, 16, 68, 2, "GR+/B" )
SETCOLOR( "W+/B" )
@ 2,15 SAY "[ CUA-Clip Interface Library - GET System Examples ]"
@ 15,14 SAY "Time:"
SETCOLOR( "BG+/B" )
@ 4,15 SAY " Printer:"
@ 4,59 SAY "<F2>"
@ 6,15 SAY " Port:"
@ 8,15 SAY "PostScript:"
//
// Standard GET with a database list. Note the use of Monitor() to
// refresh all of the GETs after a printer name has been entered.
// This will change the colour of the radio buttons and check box
// from dimmed to normal.
//
@ 4,27 GET cPrinter PICTURE "@!" ;
VALID Printer->( DBSEEK( UPPER( cPrinter ), .F. )) .AND. Monitor() ;
DBLIST aPrinters ;
COLOR "W+/N, W+/R, W/N" ;
MESSAGE "Enter the name of the printer"
//
// Radio buttons - nothing too fancy here!
//
@ 6,27 GET nPort USING RADIO WITH aPorts ;
WHEN !EMPTY( cPrinter ) ;
VALID ( nPort > 0 ) ;
COLOR "W+/B, W+/R, W/B" ;
MESSAGE "Select the port for the printer"
//
// Check box - piece of cake!
//
@ 8,27 GET lPostScript USING CHECK ;
WHEN !EMPTY( cPrinter ) ;
COLOR "W+/B, W+/R, W/B" ;
MESSAGE "Is it a PostScript printer?"
//
// Push buttons - code 'em in your sleep! Note that the ACTION expression
// returns a logical value: .T. means end the READ, .F. means continue.
//
@ 10,25 BUTTON " ~Save " ;
WHEN Updated() ;
ACTION .T. ;
COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
@ 10,43 BUTTON " ~Abort " ;
ACTION .T. ;
COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
READ
//
// Get rid of the dialog box...
//
KillBox( cScreen )
//
// Close the printer file...
//
DBNetClose( "Printer" )
//
// Reset the interrupt code block.
//
SetInterrupt( bInterrupt )
SETCOLOR( cOldColor )
RETURN NIL
//
// That's all folks!
//
/*******************************************************************
FUNCTION MyInterrupt
This is our background function that will be called during the
InterruptKey wait state.
NOTE: You must remember that this function will be called many times!
As such its processing must be kept to a minimum. In this case
we will only redisplay the time if it has changed.
Parameters: None.
Returns: NIL
*******************************************************************/
STATIC FUNCTION MyInterrupt
STATIC cOldTime
LOCAL cOldColor, ; // Colour on entry
cCurTime, ; // Current time
nRow, nCol // Position on entry
IF cOldTime == NIL
cOldTime := TIME()
ENDIF
cCurTime := TIME()
IF !( cCurTime == cOldTime )
cOldColor := SETCOLOR( "W+/B" )
nRow := ROW()
nCol := COL()
@ 15,20 SAY cCurTime
cOldTime := cCurTime
SETPOS( nRow, nCol )
SETCOLOR( cOldColor )
ENDIF
RETURN NIL
//
// EOP: MyInterrupt
//